﻿
'=====================================================================
'模 块 名：ModbusBase

'描    述：Modbus基础（公用）功能函数

'依赖模块：Imports System.Text

'调用方法：ModbusBase.xxxx()

'原始版本：1.00
'作    者：高捷朝
'完成日期：

'修改版本：1.02
'修改作者：刘德亮
'修改日期：2020-4-3
'修改记录：1.规范数据类型Long=>Int32,Integer=>Int16
'          2.增加Uint32ToInt32(),Int32ToUint32(),Uint16ToInt16(),Int16ToUint16()
'          3.其它带Word和DWord的函数都改名为Uint6和Uint32
'=====================================================================
Imports System.Text

Namespace FL_8x0.Common




    Module ModbusBase

        'Windows API (内存复制，考虑地址重叠的情况)
        Private Declare Sub CopyMemory_Uint32ToSingle Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Single, ByRef Source As UInt32, ByVal Length As UInt32)
        Private Declare Sub CopyMemory_SingleToUint32 Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As UInt32, ByRef Source As Single, ByVal Length As UInt32)

        Private Declare Sub CopyMemory_Uint32ToInt32 Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Int32, ByRef Source As UInt32, ByVal Length As UInt32)
        Private Declare Sub CopyMemory_Int32ToUint32 Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As UInt32, ByRef Source As Int32, ByVal Length As UInt32)

        Private Declare Sub CopyMemory_Uint16ToInt16 Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Int16, ByRef Source As UInt16, ByVal Length As UInt32)
        Private Declare Sub CopyMemory_Int16ToUint16 Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As UInt16, ByRef Source As Int16, ByVal Length As UInt32)



        '=====================================================================
        '模 块 名：ByteToHexString
        '入    口：byteData = 字节
        '出    口：十六进制字符串
        '功    能：字节 => 十六进制字符串"00"-"FF"
        '=====================================================================
        Public Function ByteToHexString(ByVal byteData As Byte) As String
            Dim tmp As String

            tmp = Hex(byteData)
            tmp = IIf(tmp.Length < 2, "0", "") & tmp

            Return tmp
        End Function



        '=====================================================================
        '模 块 名：HexStringToByte
        '入    口：strByte = 十六进制字符串
        '出    口：字节
        '功    能：十六进制字符串"00"-"FF" => 字节
        '=====================================================================
        Public Function HexStringToByte(ByVal strByte As String) As Byte
            Dim tmp As String = strByte

            If tmp.Length > 2 Then
                tmp = Mid(tmp, tmp.Length - 1, 2)
            ElseIf tmp.Length = 0 Then
                Return 0
            End If

            tmp = "&H" & tmp
            If IsNumeric(tmp) Then
                Return CByte(tmp)
            End If

            Return 0
        End Function



        '=====================================================================
        '模 块 名：Uint16ToHexString
        '入    口：wordData = 字
        '出    口：十六进制字符串
        '引用模块：
        '功    能：返回十六进制字符串"0000"-"FFFF"
        '=====================================================================
        Public Function Uint16ToHexString(ByVal wordData As UInt16) As String
            Dim tmp As String

            tmp = Hex(wordData)
            tmp = IIf(tmp.Length < 2, "0", "") & tmp
            tmp = IIf(tmp.Length < 3, "0", "") & tmp
            tmp = IIf(tmp.Length < 4, "0", "") & tmp

            Return tmp
        End Function



        '=====================================================================
        '模 块 名：HexStringToUint16
        '入    口：strWord = 十六进制字符串
        '出    口：字
        '功    能：十六进制字符串"0000"-"FFFF" => 字
        '=====================================================================
        Public Function HexStringToUint16(ByVal strWord As String) As UInt16
            Dim tmp As String = strWord

            If tmp.Length > 4 Then
                tmp = Mid(tmp, tmp.Length - 1, 4)
            ElseIf tmp.Length = 0 Then
                Return 0
            End If

            tmp = "&H" & tmp
            If IsNumeric(tmp) Then
                Return CUInt(tmp)
            End If

            Return 0
        End Function



        '=====================================================================
        '模 块 名：Uint32ToHexString
        '入    口：wordData = 双字
        '出    口：十六进制字符串
        '引用模块：
        '功    能：返回十六进制字符串"00000000"-"FFFFFFFF"
        '=====================================================================
        Public Function Uint32ToHexString(ByVal dwordData As UInt32) As String
            Dim tmp As String

            tmp = Hex(dwordData)
            tmp = IIf(tmp.Length < 2, "0", "") & tmp
            tmp = IIf(tmp.Length < 3, "0", "") & tmp
            tmp = IIf(tmp.Length < 4, "0", "") & tmp
            tmp = IIf(tmp.Length < 5, "0", "") & tmp
            tmp = IIf(tmp.Length < 6, "0", "") & tmp
            tmp = IIf(tmp.Length < 7, "0", "") & tmp
            tmp = IIf(tmp.Length < 8, "0", "") & tmp

            Return tmp
        End Function



        '=====================================================================
        '模 块 名：HexStringToUint32
        '入    口：strDWord = 十六进制字符串
        '出    口：双字
        '功    能：十六进制字符串"00000000"-"FFFFFFFF" => 双字
        '=====================================================================
        Public Function HexStringToUint32(ByVal strDWord As String) As UInt32
            Dim tmp As String = strDWord

            If tmp.Length > 8 Then
                tmp = Mid(tmp, tmp.Length - 1, 8)
            ElseIf tmp.Length = 0 Then
                Return 0
            End If

            tmp = "&H" & tmp
            If IsNumeric(tmp) Then
                Return CULng(tmp)
            End If

            Return 0
        End Function



        '=====================================================================
        '模 块 名：BytesArrayToString
        '入    口：bytes = 字节数组（注意：数值只能是0~127）
        '          index = 起始索引（0－N）
        '          count = 长度
        '出    口：字符串
        '功    能：字节数组 => 字符串
        '=====================================================================
        Public Function BytesArrayToString(ByRef bytes() As Byte, index As Integer, count As Integer) As String
            If bytes.Length >= count Then
                Return ASCIIEncoding.ASCII.GetString(bytes, index, count)
            Else
                Return ""
            End If
        End Function



        '=====================================================================
        '模 块 名：StringToBytesArray
        '入    口：str = 字符串
        '出    口：字节数组（注意：数值只能是0~127）
        '功    能：字符串 => 字节数组
        '=====================================================================
        Public Function StringToBytesArray(ByVal str As String) As Byte()
            Return ASCIIEncoding.ASCII.GetBytes(str)
        End Function



        '=====================================================================
        '模 块 名：Uint16ToInt16
        '入    口：uiData = 无符号字
        '出    口：有符号整型
        '引用模块：
        '功    能：无符号字 => 有符号整型
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function Uint16ToInt16(ByVal uiData As UInt16) As Int16
            Dim tmp As UInt16 = uiData

            Dim iData As Int16 = 0

            Try
                CopyMemory_Uint16ToInt16(iData, tmp, 2)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return iData
        End Function



        '=====================================================================
        '模 块 名：Int16ToUint16
        '入    口：iData = 有符号长型
        '出    口：无符号字
        '引用模块：
        '功    能：有符号整型 => 无符号字
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function Int16ToUint16(ByVal iData As Int16) As UInt16
            Dim tmp As Int16 = iData

            Dim uiData As UInt16 = 0

            Try
                CopyMemory_Int16ToUint16(uiData, tmp, 4)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return uiData
        End Function



        '=====================================================================
        '模 块 名：Uint32ToInt32
        '入    口：ulData = 无符号双字
        '出    口：有符号长整型
        '引用模块：
        '功    能：无符号双字 => 有符号长整型
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function Uint32ToInt32(ByVal ulData As UInt32) As Int32
            Dim tmp As UInt32 = ulData

            Dim lData As Int32 = 0

            Try
                CopyMemory_Uint32ToInt32(lData, tmp, 4)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return lData
        End Function



        '=====================================================================
        '模 块 名：Int32ToUint32
        '入    口：lData = 有符号长整型
        '出    口：无符号双字
        '引用模块：
        '功    能：有符号长整型 => 无符号双字
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function Int32ToUint32(ByVal lData As Int32) As UInt32
            Dim tmp As Int32 = lData

            Dim ulData As UInt32 = 0

            Try
                CopyMemory_Int32ToUint32(ulData, tmp, 4)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return ulData
        End Function



        '=====================================================================
        '模 块 名：Uint32ToSingle
        '入    口：dwordData = 双字
        '出    口：单精度浮点数
        '引用模块：
        '功    能：双字 => 单精度浮点数
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function Uint32ToSingle(ByVal ulData As UInt32) As Single
            Dim tmp As UInt32 = ulData

            Dim sigData As Single = 0

            Try
                CopyMemory_Uint32ToSingle(sigData, tmp, 4)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return sigData
        End Function



        '=====================================================================
        '模 块 名：SingleToUint32
        '入    口：sigData = 单精度浮点数
        '出    口：双字
        '引用模块：
        '功    能：单精度浮点数 => 双字
        '          【通过直接内存覆盖】
        '=====================================================================
        Public Function SingleToUint32(ByVal sigData As Single) As UInt32
            Dim tmp As Single = sigData

            Dim ulData As UInt32 = 0

            Try
                CopyMemory_SingleToUint32(ulData, tmp, 4)
            Catch ex As Exception
                'MsgBox(ex.Message)
                Return 0
            End Try

            Return ulData
        End Function



        '=====================================================================
        '模 块 名：LRC
        '入    口：strData = 字符串
        '出    口：字符串
        '功    能：冒号后到校验位前的数据
        '=====================================================================
        Public Function LRC(ByVal strData As String) As String
            Dim i As Integer

            Dim tmp As Integer
            tmp = 0

            Dim str1 As String

            For i = 1 To Len(strData) - 1 Step 2
                str1 = "&H" & Mid(strData, i, 2)
                If IsNumeric(str1) Then
                    tmp = tmp + CInt(str1)
                    If tmp >= &H100 Then tmp = tmp - &H100
                End If
            Next i

            tmp = ((Not tmp) And &HFF) + 1
            If tmp > 255 Then
                tmp = 0
            End If
            Return ByteToHexString(CByte(tmp))
        End Function




        '=====================================================================
        '模 块 名：CRC16
        '入    口：bytes = 字节数组（注意：数值只能是0~127）
        '          index = 起始索引（0－N）
        '          count = 长度
        '出    口：CRC结果
        '功    能：CRC校验位前的数据
        '=====================================================================
        Function CRC16(bytes As Byte(), index As Int32, count As Int32) As Byte()

            Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
            Dim CL As Byte, CH As Byte                '多项式码&HA001
            Dim SaveHi As Byte, SaveLo As Byte
            Dim i As UInt16
            Dim Flag As UInt16

            CRC16Lo = &HFF
            CRC16Hi = &HFF
            CL = &H1
            CH = &HA0

            For i = index To index + count - 1
                CRC16Lo = CRC16Lo Xor bytes(i) '每一个数据与CRC寄存器进行异或

                For Flag = 0 To 7
                    SaveHi = CRC16Hi
                    SaveLo = CRC16Lo
                    CRC16Hi = CRC16Hi \ 2            '高位右移一位
                    CRC16Lo = CRC16Lo \ 2            '低位右移一位

                    If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
                        CRC16Lo = CRC16Lo Or &H80    '则低位字节右移后前面补1
                    End If                           '否则自动补0

                    If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
                        CRC16Hi = CRC16Hi Xor CH
                        CRC16Lo = CRC16Lo Xor CL
                    End If
                Next Flag
            Next i

            Dim ReturnData(0 To 1) As Byte
            ReturnData(0) = CRC16Hi              'CRC高位
            ReturnData(1) = CRC16Lo              'CRC低位

            Return ReturnData
        End Function



    End Module
End Namespace